8VERSION = 3.00_table.hM(_table_table.hPixelsClass1_custom_table calias = ("") Name = "_table" custom _base.vcx_table.h.M( _tablenav_table.hPixelsClass1_table _tablenavName = "_tablenav" _table.hPx$ _findbutton3custom!Arial, 0, 9, 5, 15, 12, 13, 3, 0  _table.vcx _tablesort_table.hPixelsClass3 _container _findbutton+Top = 0 Left = 48 Name = "cusTableFind"  _findbutton cusTableFindcustom _table.vcx _tablefind_table.hM(JArial, 0, 9, 5, 15, 12, 32, 3, 0 MS Sans Serif, 0, 9, 5, 13, 11, 11, 2, 0  _gotodialog_table.hPixelsClass4_form _gotodialog2PROCEDURE Click THIS.Parent.DoFind() ENDPROC PixelsPixelsClass1_table _tablesortName = "_tablesort" customPixels _findbutton cmdTableFind commandbutton _base.vcx container _table.vcx_table.hF M(_commandbutton _base.vcx_table.hPx$ _tablefind_table.hClass1_table.h_table7vAutoSize = .T. Top = 0 Left = 0 Height = 27 Width = 42 Caption = "\ %%A%U9CC CUTHISFORM CUSTABLENAV GOTORECORDSPNGOTOVALUEREFRESHLASTWINDOWAFTERCHANGERELEASEClick,12)%"PROCEDURE Click THISFORM.cusTableNav.GoToRecord(THISFORM.spnGoTo.Value) * we may not have moved but we may have reverted data * so we have to refresh whether the pointer has * moved or not THISFORM.cusTableNav.RefreshLastWindowAfterChange() THISFORM.Release() ENDPROC cAutoSize = .T. Top = 48 Left = 65 FontName = "MS Sans Serif" Caption = "\/R,:CFilter must be <255 characters.= CbL /R,:CFilter must be logical in type.=2- TaTBCa6ULLRETURNLCVALUETHISVALUE MAXLENGTHTHISFORMCFILTERValid,1aAAR3)3PROCEDURE Valid LOCAL llReturn, lcValue lcValue = STRTRAN(ALLTRIM(THIS.Value),CHR(13),SPACE(1)) lcValue = STRTRAN(lcValue,CHR(9),SPACE(1)) lcValue = STRTRAN(lcValue,CHR(10),SPACE(1)) DO CASE CASE EMPTY(lcValue) llReturn = .T. CASE LEN(lcValue) > THIS.MaxLength WAIT WINDOW LEFT(SETFILTER_MAXLENGTH_LOC,254) NOWAIT CASE TYPE(lcValue) # "L" WAIT WINDOW LEFT(SETFILTER_INVALID_LOC,254) NOWAIT OTHERWISE llReturn = .T. THISFORM.cFilter = lcValue ENDCASE RETURN IIF(llReturn,.T.,0) ENDPROC FontName = "MS Sans Serif" Height = 99 Left = 8 MaxLength = 254 TabIndex = 2 Top = 19 Width = 312 ZOrderSet = 2 Value = ("") ControlSource = "THISFORM.cFilter" IntegralHeight = .T. Name = "edtFilterExpression" _editboxATop = 5 Left = 298 Height = 15 Width = 24 Name = "cusTable"  _filterexprcusTable _table.vcx;cfilter The filter expression. ladvanced This is used to toggle _FilterExpr between two modes (_FilterDialog and GETEXPR). ioldsession Old data session. ioldselect Old work area. *setfilter Sets the value of the cFilter property. This method is primarily useful when _FilterDialog is called modally to do further work on the expression to be built. *setfilterontable If the current table allows navigation according to the dialog's _table member, this method applies the current filter to the current alias, issues a LOCATE to refresh the filter. *cfilter_access Height = 155 Width = 328 DoCreate = .T. AutoCenter = .T. BorderStyle = 0 Caption = "Set Filter" WindowType = 1 cfilter = (SPACE(254)) ioldsession = 0 ioldselect = 0 Name = "_filterexpr"  _base.vcx_table.hM(RMS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 MS Sans Serif, 0, 9, 5, 13, 11, 11, 2, 0  _filterdialog_table.hPixelsClass_form _filterdialogVPROCEDURE cfindstring_assign LPARAMETERS tcNewVal STORE tcNewVal TO THIS.cusTableFind.cFindString, THIS.cFindString THIS.SetButtonUI() ENDPROC PROCEDURE calias_assign LPARAMETERS tcNewVal STORE tcNewVal TO THIS.cusTableFind.cAlias, THIS.cAlias THIS.SetButtonUI() ENDPROC PROCEDURE dofind LPARAMETERS tcString, tcAlias THIS.cusTableFind.DoFind(tcString,tcAlias) THIS.SetButtonUI() ENDPROC PROCEDURE lwraparound_assign LPARAMETERS tlNewVal STORE tlNewVal TO THIS.cusTableFind.lWrapAround, THIS.lWrapAround THIS.SetButtonUI() ENDPROC PROCEDURE lmatchcase_assign LPARAMETERS tlNewVal STORE tlNewVal TO THIS.cusTableFind.lMatchCase, THIS.lMatchCase THIS.SetButtonUI() ENDPROC PROCEDURE lskipmemos_assign LPARAMETERS tlNewVal STORE tlNewVal TO THIS.cusTableFind.lSkipMemos, THIS.lSkipMemos THIS.SetButtonUI() ENDPROC PROCEDURE lfindagain_assign LPARAMETERS tlNewVal STORE tlNewVal TO THIS.cusTableFind.lFindAgain, THIS.lFindAgain THIS.SetButtonUI() ENDPROC PROCEDURE skipfield LPARAMETERS tcField THIS.cusTableFind.SkipField(tcField) THIS.SetButtonUI() ENDPROC PROCEDURE cfindstring_access RETURN THIS.cusTableFind.cfindstring ENDPROC PROCEDURE calias_access RETURN THIS.cusTableFind.calias ENDPROC PROCEDURE lwraparound_access RETURN THIS.cusTableFind.lwraparound ENDPROC PROCEDURE lfindagain_access RETURN THIS.cusTableFind.lfindagain ENDPROC PROCEDURE lskipmemos_access RETURN THIS.cusTableFind.lskipmemos ENDPROC PROCEDURE lmatchcase_access RETURN THIS.cusTableFind.lmatchcase ENDPROC PROCEDURE setbuttonui THIS.cmdTableFind.Enabled = (NOT EMPTY(THIS.cAlias)) AND ; (NOT EMPTY(THIS.cFindString)) IF THIS.lFindAgain THIS.cmdTableFind.Caption = FIND_FINDNEXT_LOC ELSE THIS.cmdTableFind.Caption = FIND_FIND_LOC ENDIF ENDPROC PROCEDURE Init IF NOT DODEFAULT() RETURN .F. ENDIF * autosize the button for the larger caption, * then turn off the autosize THIS.cmdTableFind.AutoSize = .T. THIS.cmdTableFind.Caption = FIND_FINDNEXT_LOC THIS.cmdTableFind.AutoSize = .F. THIS.SetButtonUI() ENDPROC (Top = 4 Left = 211 Name = "cusTable"  _filterdialogcusTablecustom _table.vcx_tableFontBold = .F. FontName = "MS Sans Serif" FontSize = 9 RowSourceType = 5 RowSource = "" Value = 1 Enabled = .T. Height = 20 Left = 12 Sorted = .F. SpecialEffect = 0 Style = 2 TabIndex = 5 Top = 46 Width = 108 ReleaseErase = .F. BorderStyle = 1 Name = "cboFieldname"  _filterdialog cboFieldnamecombobox _base.vcx _comboboxP 77%U>T% +(~"TC$T*OR*T!T*OR*TT C U LIITHISFORMIBACT LSTQUERYPARTSVALUEIQPTRAQUERY SETACTIONREFRESHClick,1q!AAAq17)7BPROCEDURE Click LOCAL lii THISFORM.ibact = 4 IF THISFORM.lstQueryParts.Value < THISFORM.iQptr FOR lii = THISFORM.iQptr TO THISFORM.lstQueryParts.Value+1 STEP -1 THISFORM.aQuery(lii+1) = THISFORM.aQuery(lii) ENDFOR THISFORM.aQuery(THISFORM.lstQueryParts.Value + 1) = "*OR*" THISFORM.lstQueryParts.Value = THISFORM.lstQueryParts.Value + 2 ELSE THISFORM.aQuery(THISFORM.iQptr+1) = "*OR*" THISFORM.lstQueryParts.Value = THISFORM.iQptr + 2 ENDIF THISFORM.iQptr = THISFORM.iQptr + 1 THISFORM.SetAction() THISFORM.lstQueryParts.Refresh ENDPROC  _filterdialogcmdOr commandbutton _base.vcx_commandbutton _filterdialogcmdDown %%9fJU% % TCy(CCCCCXU TLFORCEREFRESHTHISFORM LADVANCEDTHISCLEARAALIASESLIALIAS LIALIASCOUNTADDITEMRefresh,1q!qA!AA2d) %WU CUTHISFORMSETFINDBUTTONENABLE %C  (l%Ch Ta!% CTUTHIS DISPLAYVALUELIITEMLLFOUND LISTCOUNTLISTADDITEMVALUEInteractiveChange,Valid_14AAA!AAA3?[)  %ShbU CUTHISFORMRELEASEClick,12%) d%cxrUCUTHISFORM CUSTABLEFINDDOFINDClick,121)AutoSize = .F. Top = 245 Left = 134 Height = 23 Width = 45 FontName = "MS Sans Serif" FontSize = 9 Caption = "\ K)pFontName = "MS Sans Serif" FontSize = 8 Value = (THISFORM.cAlias) Height = 24 Left = 78 Style = 2 TabIndex = 4 Top = 48 Width = 216 Name = "cboTables" AutoSize = .T. FontName = "MS Sans Serif" FontSize = 8 BackStyle = 0 BorderStyle = 0 Caption = "Look \%C*_SCREEN.ActiveForm.ActiveControl.BaseClassbCFT9%CfGRID-T)% %+%CloColumn.CurrentControlbCTC loColumn.  T!B T BU LOREALACTIVECONTROL LITHISCOLUMNLOACTIVECONTROLLOCOLUMN ACTIVEFORM ACTIVECONTROL BASECLASS ACTIVECOLUMNCOLUMNS COLUMNORDERCURRENTCONTROLcTC<%C*CloCurrentControl.ControlSourcebC %CC BCC.Cf BTCf CTC. TC H& C. CO   T C G T TC>T. TC>T" C=M  T2%CC\  T%C S%CbUO T BU LCFIELDNAMELOCURRENTCONTROLIPOSLCALIASTHISGETCURRENTCONTROL CONTROLSOURCESETTOACTIVESESSIONTC DATASESSIONv H.D C _SCREEN.ActiveForm.DatasessionIDbN 9 G(9N C'_SCREEN.ActiveForm.Parent.DatasessionIDbN9 G(92U LISESSION ACTIVEFORM DATASESSIONIDPARENT H - C_SCREEN.ActiveForm.ParentbOLC9& C_SCREEN.ActiveFormbOC92%CC  ,CU ACTIVEFORMPARENTREFRESH#CCCC %C]TCr T%C  CCN  T/%C CC BUFFERING TC%C u%%CCC>=fCf.qTC8%C CValueh C   m Ta% %TCC1C.Q BU TCALIASLCALIASLLRETURNLOCURRENTCONTROLLCCURRENTFIELDTHISGETCURRENTALIASGETCURRENTBOUNDFIELDGETCURRENTCONTROLVALUE#CCCC %C C \ TuTC%C  CCN  T %C  C q%CCTC Before moving to another record,C do you wish to: C C  SAVE changes (Yes)C  REVERT changes (No) orC  REMAIN on the record (Cancel)?3"Data in this row has been changed.x T Hm C : C%Ca 6 T X C-2m T BC UTCALIASLCALIASLIRETURNTHISGETCURRENTALIASCURRENTROWBUFFEREDANDCHANGED STARTMODEFLUSHCURRENTCONTROLiT9%CTHISFORMbOK T^ T Hob ?(;TC9%C  .%CfFORM7!%C loForm.ParentbOC / C ! 9 Z C9 2bU LOFORMLIFORMS LITHISFORM LOTHISFORM FORMCOUNTTHISFORMFORMS BASECLASSPARENTREFRESHVISIBLE#CCCC # %C C  TTC %C TCf TaTC 6+C!loCurrentControl.Parent.BaseclassbCUT %CfGRIDQ T!B%CloCurrentGrid.NamebCC   T- %TC y( TTCCC f+C w%> T-!sTTCCC f% !% C  BUTCALIASLCALIASLLRETURNLOCURRENTCONTROL LOCURRENTGRIDLIINDEXLITABLESLITARGETLCTARGETLATABLESTHISGETCURRENTALIASGETCURRENTCONTROLPARENT BASECLASS LINKMASTER CHILDORDERRELATIONALEXPRDOTARGETOFRELATIONMESSAGE!%CBUTCALIAS#CCCC %C]TCr T%C  CCN  T/%C CC BUFFERING zTC%C v%%CCC>=fCf.rTC&%C CValueh nT  Ta BU TCALIASLCALIASLLRETURNLOCURRENTCONTROLLCCURRENTFIELDTHISGETCURRENTALIASGETCURRENTBOUNDFIELDGETCURRENTCONTROLVALUEgetcurrentalias,getcurrentcontrolgetcurrentboundfieldsettoactivesessionrefreshuiafterchangecurrentrowbufferedandchangedzcurrenttableallowsnavigation refreshlastwindowafterchange currenttableallowsorderingdotargetofrelationmessageNflushcurrentcontrol|1qB31""BBBBBBB34"A!A2c1a1"ABAAA6qCBD2!aAA2q12AARAAASAB4q2AAr4AQAAB31ArAAAAAAAB4q232AbAAB%BB%rAAAAABBA4qAA2q12AARb1AAAB3 Q | @G Q \Mw"9" #J#Y') qq5@%NLU|#%CC CbL > T[TCXJ(UTCVALUELCFILTERTHISEDTFILTEREXPRESSION MAXLENGTHCFILTERVALUEc%CC\TSET FILTER TO &lcFilter -CUTHISCUSTABLECURRENTTABLEALLOWSNAVIGATIONLCFILTERTHISFORMCFILTERREFRESHLASTWINDOWAFTERCHANGE%C(TCXTCCC CXTCC CXTCC CX BULCVALUETHISCFILTERO%C B- %CC}TC DATASESSIONv%CCyQ Hy- C_SCREEN.ActiveForm.ParentbOG(9& C_SCREEN.ActiveFormbOG(92%CCy 0TCWFCMG(B-yTCWFC&TC \ 1 AND ; THISFORM.lstQueryParts.Value <= THISFORM.iQptr lcx = THISFORM.aQuery(THISFORM.lstQueryParts.Value-1) THISFORM.aQuery(THISFORM.lstQueryParts.Value-1) = ; THISFORM.aQuery(THISFORM.lstQueryParts.Value) THISFORM.aQuery(THISFORM.lstQueryParts.Value) = lcx THISFORM.lstQueryParts.Value = THISFORM.lstQueryParts.Value - 1 ENDIF THISFORM.SetAction() THISFORM.lstQueryParts.Enabled = .T. ENDPROC AutoSize = .F. Top = 245 Left = 206 Height = 23 Width = 47 FontName = "MS Sans Serif" FontSize = 9 Caption = "\ CC6T C U THISFORMADBFSTHISVALUESETTAGSCBOORDERREQUERY CBOFIELDNAMEATAGSFSET CUTHISINTERACTIVECHANGEInteractiveChange,ProgrammaticChange1A141 @X ) _filterdialog edtSoughteditbox _base.vcx_editbox _filterdialog cboOperatorcombobox _base.vcxlabel _base.vcx_labelcPROCEDURE InteractiveChange SELECT (THISFORM.aDbfs[THIS.Value]) THISFORM.SetTags() THISFORM.cboOrder.Requery() THISFORM.cboFieldname.Requery() THISFORM.cboOrder.Value = IIF(LEN(ORDER())=0,1,ASCAN(THISFORM.aTags,ORDER())) THISFORM.cboFieldname.Value = 1 THISFORM.FSet() ENDPROC PROCEDURE ProgrammaticChange THIS.InteractiveChange() ENDPROC FontBold = .F. FontName = "MS Sans Serif" FontSize = 9 RowSourceType = 5 Value = 1 Enabled = .T. Height = 20 Left = 50 Sorted = .F. SpecialEffect = 0 Style = 2 TabIndex = 2 Top = 5 Width = 155 ReleaseErase = .F. BorderStyle = 1 Name = "cboTables" ? &&u% UcTCC%CfRECORD#CG((W G((#)ULCXTHISFORMATAGSCBOORDERVALUEValid,1qaAQ1)&FontBold = .F. FontName = "MS Sans Serif" FontSize = 9 RowSourceType = 5 Value = 1 Enabled = .T. Height = 20 Left = 271 Sorted = .F. SpecialEffect = 0 Style = 2 TabIndex = 4 Top = 5 Width = 112 ReleaseErase = .F. BorderStyle = 1 Name = "cboOrder"  ~~e% U* C C CUTHISFORM SETACTIONQSETFSET CUTHISVALID CUTHISVALIDValid,InteractiveChange{ProgrammaticChange1222Go{ )~PROCEDURE Valid THISFORM.SetAction() THISFORM.QSet() THISFORM.FSet() ENDPROC PROCEDURE InteractiveChange THIS.Valid() ENDPROC PROCEDURE ProgrammaticChange THIS.Valid() ENDPROC  _combobox _filterdialog lblCriterialabel _base.vcx_label _filterdialog lblTableslabel _base.vcx_label _filterdialog >%z_FUCt CN TC#%C CN {# CUTIRECORDLCALIASTHISGETCURRENTALIASCURRENTTABLEALLOWSNAVIGATIONREFRESHUIAFTERCHANGEMTC%CF #) CULCALIASTHISGETCURRENTALIASCURRENTTABLEALLOWSNAVIGATIONREFRESHUIAFTERCHANGEMTC%CF #6 CULCALIASTHISGETCURRENTALIASCURRENTTABLEALLOWSNAVIGATIONREFRESHUIAFTERCHANGETC%C H%C+H% C C C C CU LCALIASTHISGETCURRENTALIASCURRENTTABLEALLOWSNAVIGATIONLCYCLEDOCYCLETOPMESSAGEGOTOPREFRESHUIAFTERCHANGEDOBOTTOMMESSAGE?TC%C C ;B HL8 C H%C% C C C C C0% C C C, C28U LCALIASTHISGETCURRENTALIASCURRENTTABLEALLOWSNAVIGATIONLCYCLEDOCYCLEBOTTOMMESSAGEGOBOTTOM DOTOPMESSAGEREFRESHUIAFTERCHANGE gotorecord,gotopgobottomgonextZ goprevious1qr3B4qRB3qRB3qRAAB4qAAAAAB2K g6!.*PH)[PROCEDURE gotorecord LPARAMETERS tiRecord ASSERT PCOUNT() = 1 AND VARTYPE(tiRecord) = "N" LOCAL lcAlias lcAlias = THIS.GetCurrentAlias() IF THIS.CurrentTableAllowsNavigation(lcAlias) AND ; (RECCOUNT(lcAlias) >= tiRecord) GO tiRecord IN (lcAlias) THIS.RefreshUIAfterChange() ENDIF ENDPROC PROCEDURE gotop LOCAL lcAlias lcAlias = THIS.GetCurrentAlias() IF THIS.CurrentTableAllowsNavigation(lcAlias) GO TOP IN (lcAlias) THIS.RefreshUIAfterChange() ENDIF ENDPROC PROCEDURE gobottom LOCAL lcAlias lcAlias = THIS.GetCurrentAlias() IF THIS.CurrentTableAllowsNavigation(lcAlias) GO BOTTOM IN (lcAlias) THIS.RefreshUIAfterChange() ENDIF ENDPROC PROCEDURE gonext LOCAL lcAlias lcAlias = THIS.GetCurrentAlias() IF THIS.CurrentTableAllowsNavigation(lcAlias) SKIP IN (lcAlias) IF EOF(lcAlias) SKIP -1 IN (lcAlias) IF THIS.lCycle THIS.DoCycleTopMessage() THIS.GoTop() THIS.RefreshUIAfterChange() ELSE THIS.DoBottomMessage() ENDIF ELSE THIS.RefreshUIAfterChange() ENDIF ENDIF ENDPROC PROCEDURE goprevious LOCAL lcAlias lcAlias = THIS.GetCurrentAlias() IF EMPTY(lcAlias) OR ; NOT THIS.CurrentTableAllowsNavigation(lcAlias) RETURN ENDIF DO CASE CASE (NOT BOF(lcAlias)) SKIP -1 IN (lcAlias) IF BOF(lcAlias) IF THIS.lCycle THIS.DoCycleBottomMessage() THIS.GoBottom() ELSE THIS.DoTopMessage() ENDIF ENDIF THIS.RefreshUIAfterChange() CASE BOF(lcAlias) IF THIS.lCycle THIS.DoCycleBottomMessage() THIS.GoBottom() THIS.RefreshUIAfterChange() ELSE THIS.DoTopMessage() ENDIF OTHERWISE ENDCASE ENDPROC ldescending Whether order is ascending or descending. *dosort DoSort([tcField] [,tcAlias] [,tcTag] [,tlDescending]) allows you to specify exactly what order in what table you would like to set -- or, if you prefer, which field in a given alias you would like to set order to. *getsorttag Looks for an appropriate tagname by looking at key expressions in this table relevant to this fieldname. *removesort Removes the current order (index tag).   %Y s q U  CBC4CC$CCC.6bU  $CCCC  CC  C CC CL   %Ct T T   H)% CC TC %C TC.TC=TC\ TTC C C  T T2% TTC%C FB-%CC%C  T CW F%CCW  T %C  F '%C C.bU B-%C )T C%C %CY TuTIN  % ,SET ORDER TO (lcTag) &lcAlias DESCENDING +SET ORDER TO (lcTag) &lcAlias ASCENDING  C BC UTCFIELDTCALIASTCTAG TLDESCENDINGTHISSETTOACTIVESESSIONLCFIELDLCALIASLIPOSLCTAGLISELECT LLDESCENDING LDESCENDINGGETCURRENTBOUNDFIELDGETCURRENTALIASCURRENTTABLEALLOWSORDERING GETSORTTAGREFRESHUIAFTERCHANGE CCC C.bU'  TCfTCf T TCWTCEXACTv FG TCVT Cf.% (TCC mf%CbUTCr,%  UPPER() UPPER( ) UPPER(+ UPPER( + LOWER() LOWER( ) LOWER(+ LOWER( + PROPER() PROPER( ) PROPER(+ PROPER( + SUBSTR(, SUBSTR( , LEFT(, LEFT( , SUBSTRC(, SUBSTRC( , LEFTC(, LEFTC( , TCC f!SET EXACT &lcExact F BU TCFIELDTCALIASLCALIASLCFIELDLITAGSLISELECTLCKEYLCEXACTLCTAGLCALIASEDFIELDLNINDEX C$CCCC  %C_TCt T%C B-G((0 CUTCALIASTHISSETTOACTIVESESSIONLCALIASGETCURRENTALIASREFRESHUIAFTERCHANGEdosort, getsorttag% removesortN 11$BbA1aaAAbqARA2AABrqAAAAAB3sAarA `"ABBBBc2qBrAqA2@Da6dbW) PROCEDURE dosort LPARAMETERS tcField, tcAlias, tcTag, tlDescending THIS.SetToActiveSession() ASSERT EMPTY(tcField) OR ; (VARTYPE(tcField) = "C" AND ; TYPE(IIF(EMPTY(tcAlias),"",tcAlias+".")+tcField) # "U") ASSERT EMPTY(tcAlias) OR (VARTYPE(tcAlias) = "C" AND USED(tcAlias)) ASSERT EMPTY(tcAlias) OR (NOT EMPTY(tcField)) ASSERT EMPTY(tcTag) OR VARTYPE(tcTag) = "C" ASSERT VARTYPE(tlDescending) = "L" LOCAL lcField, lcAlias, liPos, lcTag, liSelect, llDescending IF PCOUNT() > 3 llDescending = tlDescending ELSE llDescending = THIS.lDescending ENDIF DO CASE CASE EMPTY(tcAlias) AND EMPTY(tcField) lcField = THIS.GetCurrentBoundField() * will be properly aliased if one can be found IF NOT EMPTY(lcField) liPos = AT(".",lcField) lcAlias = LEFT(lcField,liPos-1) lcField = SUBSTR(lcField,liPos+1) ELSE lcField = "" lcAlias = THIS.GetCurrentAlias() ENDIF CASE (NOT EMPTY(tcAlias)) AND USED(tcAlias) lcField = tcField lcAlias = tcAlias OTHERWISE lcField = tcField lcAlias = THIS.GetCurrentAlias() ENDCASE IF NOT THIS.CurrentTableAllowsOrdering(lcAlias) RETURN .F. ENDIF IF VARTYPE(tcTag) = "C" * the SELECTs are necessary * because TAGNO() doesn't work * on the non-selected area properly, * although it is doc'd to work... IF NOT EMPTY(lcAlias) liSelect = SELECT() SELECT (lcAlias) ENDIF IF NOT EMPTY(TAGNO(tcTag)) lcTag = tcTag ENDIF IF NOT EMPTY(lcAlias) SELECT (liSelect) ENDIF ENDIF IF EMPTY(lcTag) AND (TYPE(lcAlias+"."+lcField) = "U") RETURN .F. ENDIF IF EMPTY(lcTag) lcTag = THIS.GetSortTag(lcField,lcAlias) ENDIF IF NOT EMPTY(lcTag) IF EMPTY(lcAlias) lcAlias = "" ELSE lcAlias = "IN "+lcAlias ENDIF IF llDescending SET ORDER TO (lcTag) &lcAlias DESCENDING ELSE SET ORDER TO (lcTag) &lcAlias ASCENDING ENDIF THIS.RefreshUIAfterChange() ENDIF RETURN (NOT EMPTY(lcTag)) ENDPROC PROCEDURE getsorttag LPARAMETERS tcField, tcAlias ASSERT VARTYPE(tcAlias) = "C" AND USED(tcAlias) ASSERT TYPE(tcAlias+"."+tcField) # "U" LOCAL lcAlias, lcField, liTags, liSelect, lcKey, lcExact, lcTag, lcAliasedField, ; lnIndex lcAlias = UPPER(tcAlias) && must be passed! lcField = UPPER(tcField) && ditto! lcTag = "" liSelect = SELECT() lcExact = SET("EXACT") SELECT (lcAlias) SET EXACT OFF liTags = TAGCOUNT() lcAliasedField = UPPER(lcAlias)+"."+lcField IF liTags > 0 FOR lnIndex = 1 to liTags lcKey = UPPER(KEY(lnIndex)) IF TYPE(lcKey) # "U" * this test makes sure that the index expression * can be evaluated in the current environment * now test to see if we can use it for * the current purpose, with an inexact * comparison since that's all we need * for an adequate sort lcKey = NORMALIZE(lcKey) IF lcKey = lcField OR ; lcKey = lcAliasedField OR ; lcKey = "UPPER("+lcField+")" OR ; lcKey = "UPPER("+lcAliasedField+")" OR ; lcKey = "UPPER("+lcField+"+" OR ; lcKey = "UPPER("+lcAliasedField+"+" OR ; lcKey = "LOWER("+lcField+")" OR ; lcKey = "LOWER("+lcAliasedField+")" OR ; lcKey = "LOWER("+lcField+"+" OR ; lcKey = "LOWER("+lcAliasedField+"+" OR ; lcKey = "PROPER("+lcField+")" OR ; lcKey = "PROPER("+lcAliasedField+")" OR ; lcKey = "PROPER("+lcField+"+" OR ; lcKey = "PROPER("+lcAliasedField+"+" OR ; lcKey = "SUBSTR("+lcField+"," OR ; lcKey = "SUBSTR("+lcAliasedField+"," OR ; lcKey = "LEFT("+lcField+"," OR ; lcKey = "LEFT("+lcAliasedField+"," OR ; lcKey = "SUBSTRC("+lcField+"," OR ; lcKey = "SUBSTRC("+lcAliasedField+"," OR ; lcKey = "LEFTC("+lcField+"," OR ; lcKey = "LEFTC("+lcAliasedField+"," lcTag = UPPER(TAG(lnIndex)) EXIT ENDIF ENDIF ENDFOR ENDIF SET EXACT &lcExact SELECT (liSelect) RETURN lcTag ENDPROC PROCEDURE removesort LPARAMETERS tcAlias THIS.SetToActiveSession() ASSERT EMPTY(tcAlias) OR (VARTYPE(tcAlias) = "C" AND USED(tcAlias)) LOCAL lcAlias IF EMPTY(tcAlias) lcAlias = THIS.GetCurrentAlias() ELSE lcAlias = tcAlias ENDIF IF NOT USED(lcAlias) RETURN .F. ENDIF SET ORDER TO 0 IN (lcAlias) THIS.RefreshUIAfterChange() ENDPROC Top = 99 Left = 117 Height = 15 Width = 74 FontName = "MS Sans Serif" FontSize = 8 AutoSize = .T. BackStyle = 0 Caption = "\cfields List of fields to search. imemos cfindstring The string to search for. Defaults to a null string. ccontrolcharacter lwraparound Whether to continue searching from beginning if end of file reached. lmatchcase Case-sensitivity. lskipmemos Whether to skip searching of memos. lfindagain This determines whether the class will perform a SKIP before its next check, allowing you to move through a file finding successive instances of a string. ^amemos[1,0] *skipfield This method allows you to eliminate any particular field or fields from the search. *dofind This is ordinarily the only method you need to call to do search. *calias_assign *cfindstring_assign *showmessagenotfound *ccontrolcharacter_assign *setfields *lwraparound_assign *lmatchcase_assign *lskipmemos_assign *lfindagain_assign \ CC9O%vU%C CC )B H: CfNEXTaC CfPREVIOUSC2UTCACTIONTHIS CUSTABLENAVGONEXT GOPREVIOUSBUTHIS CUSTABLENAVLCYCLE! T UVNEWVALTHIS CUSTABLENAVLCYCLEtablenav, lcycle_access lcycle_assign-1qAAqB23Q2 ?_)CJlwraparound Whether to continue searching from beginning if end of file reached. lmatchcase Case-sensitivity. lskipmemos Whether to skip searching in memo fields. lfindagain This determines whether the class will perform a SKIP before its next check, allowing you to move through a file finding successive instances of a string. calias The data source to search in. cfindstring The search string. ladvanced Whether to display advanced options in dialog. *clearfindstrings *setfindbuttoncaption *setfindbuttonenable *lwraparound_access *lwraparound_assign *lmatchcase_access *lmatchcase_assign *lskipmemos_access *lskipmemos_assign *lfindagain_access *lfindagain_assign *calias_access *calias_assign *cfindstring_access *cfindstring_assign *skipfield *dofind *refreshtablechoices *ladvanced_assign  zzR+%1U%C CC )B C HG CfTOPmC CfBOTTOMC2UTCACTIONTHIS CUSTABLENAVGOTOPGOBOTTOMtablenav,1qAAaB1$)z %avpUCTOPUTHISPARENTTABLENAVClick,1a1,)Top = 12 Left = 305 Height = 23 Width = 63 FontName = "MS Sans Serif" FontSize = 8 Caption = "\ 0 THIS.lAdvanced = tlAdvanced ELSE THIS.lAdvanced = THIS.lAdvanced * default to the value of the property, * but still synch up the positioning * of the objects on the form to the current state ENDIF * localize strings THIS.Caption = FIND_CAPTION_LOC THIS.lblFind.Caption = FIND_LOOKFOR_LOC THIS.lblOptions.Caption = FIND_OPTIONS_LOC THIS.chkWrapAround.Caption = FIND_WRAPAROUND_LOC THIS.chkMatchCase.Caption = FIND_MATCHCASE_LOC THIS.chkSkipMemos.Caption = FIND_SKIPMEMOS_LOC THIS.cmdFind.Caption = FIND_FIND_LOC THIS.cmdCancel.Caption = FIND_CANCEL_LOC THIS.lblLookIn.Caption = FIND_LOOKIN_LOC * bindings to member properties occurs * here rather than properties window * because of possible order conflicts (the * custom object may be created after some * of the members we wish to bind to its properties): THIS.cboFindString.ControlSource = "THISFORM.cusTableFind.cFindString" THIS.cboTables.ControlSource = "THISFORM.cusTableFind.cAlias" THIS.chkWrapAround.ControlSource = "THISFORM.cusTableFind.lWrapAround" THIS.chkSkipMemos.ControlSource = "THISFORM.cusTableFind.lSkipMemos" THIS.chkMatchCase.ControlSource = "THISFORM.cusTableFind.lMatchCase" IF SYSTEM_LARGEFONTS THIS.SetAll("FontName",DIALOG_LARGEFONT_NAME) ENDIF ENDPROC PROCEDURE Show LPARAMETERS nStyle THIS.RefreshTableChoices() DO CASE CASE EMPTY(THIS.cusTableFind.cAlias) THIS.cusTableFind.cAlias = THIS.cusTableFind.GetCurrentAlias() CASE NOT USED(THIS.cusTableFind.cAlias) THIS.cusTableFind.cAlias = "" OTHERWISE * leave it alone ENDCASE THIS.SetFindButtonCaption() THIS.SetFindButtonEnable() IF NOT THIS.cmdFind.Enabled IF EMPTY(THIS.cFindString) KEYBOARD SPACE(1)+"{HOME}" ELSE KEYBOARD THIS.cFindString ENDIF ENDIF ENDPROC  IPROCEDURE skipfield LPARAMETERS tcField DODEFAULT(tcField) THISFORM.SetFindButtonCaption() THISFORM.SetFindButtonEnable() ENDPROC PROCEDURE setfields DODEFAULT() THISFORM.SetFindButtonCaption() THISFORM.SetFindButtonEnable() ENDPROC PROCEDURE lwraparound_assign LPARAMETERS tlVal DODEFAULT(tlVal) THISFORM.SetFindButtonCaption() THISFORM.SetFindButtonEnable() ENDPROC PROCEDURE lskipmemos_assign LPARAMETERS tlVal DODEFAULT(tlVal) THISFORM.SetFindButtonCaption() THISFORM.SetFindButtonEnable() ENDPROC PROCEDURE lmatchcase_assign LPARAMETERS tlVal DODEFAULT(tlVal) THISFORM.SetFindButtonCaption() THISFORM.SetFindButtonEnable() ENDPROC PROCEDURE lfindagain_assign LPARAMETERS tlVal DODEFAULT(tlVal) THISFORM.SetFindButtonCaption() THISFORM.SetFindButtonEnable() ENDPROC PROCEDURE cfindstring_assign LPARAMETERS tcString DODEFAULT(tcString) THISFORM.SetFindButtonCaption() THISFORM.SetFindButtonEnable() ENDPROC PROCEDURE dofind LPARAMETERS tcString, tcAlias IF DODEFAULT(tcString, tcAlias) THISFORM.cusTableFind.RefreshLastWindowAfterChange() ENDIF THISFORM.SetFindButtonEnable() THISFORM.SetFindButtonCaption() RETURN *!* * the commented version below can *!* * replace the above if "multiple find" *!* * is inadvisable on a modal dialog, *!* * for any reason, *!* * but it seems to be okay *!* IF DODEFAULT(tcString, tcAlias) *!* THISFORM.cusTableFind.RefreshLastWindowAfterChange() *!* IF THISFORM.WindowType = 1 *!* THISFORM.Release() *!* ENDIF *!* ELSE *!* IF THISFORM.WindowType = 1 *!* THISFORM.Release() *!* ELSE *!* THISFORM.SetFindButtonEnable() *!* THISFORM.SetFindButtonCaption() *!* ENDIF *!* ENDIF ENDPROC PROCEDURE calias_assign LPARAMETERS tcAlias DODEFAULT(tcAlias) LOCAL liAlias, llFound, llEmpty IF EMPTY(THIS.cAlias) THISFORM.Caption = FIND_CAPTION_LOC llEmpty = .T. ELSE THISFORM.Caption = FIND_FINDIN_LOC+" "+ PROPER(THIS.cAlias) ENDIF THISFORM.SetFindButtonEnable() THISFORM.SetFindButtonCaption() IF THISFORM.lAdvanced IF NOT llEmpty FOR liAlias = 1 TO THISFORM.cboTables.ListCount llFound = (THIS.cAlias == THISFORM.cboTables.List(liAlias)) IF llFound EXIT ENDIF ENDFOR ENDIF IF NOT (llFound OR llEmpty) THISFORM.cboTables.AddItem(THIS.cAlias) ENDIF STORE THIS.cAlias TO THISFORM.cboTables.Value, ; THISFORM.cboTables.DisplayValue THISFORM.cboTables.Refresh() ENDIF ENDPROC  l l z%53<U1J( CUTCNEWVALTHIS CUSTABLEFIND CFINDSTRING SETBUTTONUI1J( CUTCNEWVALTHIS CUSTABLEFINDCALIAS SETBUTTONUI3 C CUTCSTRINGTCALIASTHIS CUSTABLEFINDDOFIND SETBUTTONUI1J( CUTLNEWVALTHIS CUSTABLEFIND LWRAPAROUND SETBUTTONUI1J( CUTLNEWVALTHIS CUSTABLEFIND LMATCHCASE SETBUTTONUI1J( CUTLNEWVALTHIS CUSTABLEFIND LSKIPMEMOS SETBUTTONUI1J( CUTLNEWVALTHIS CUSTABLEFIND LFINDAGAIN SETBUTTONUI+C CUTCFIELDTHIS CUSTABLEFIND SKIPFIELD SETBUTTONUIBUTHIS CUSTABLEFIND CFINDSTRINGBUTHIS CUSTABLEFINDCALIASBUTHIS CUSTABLEFIND LWRAPAROUNDBUTHIS CUSTABLEFIND LFINDAGAINBUTHIS CUSTABLEFIND LSKIPMEMOSBUTHIS CUSTABLEFIND LMATCHCASE~(TC  C  %VT Find \ 1 AND ; VARTYPE(lcFieldName) = "O" * we can't use a member object, * we're looking for a table attribute/column lcFieldName = "" CASE iPos <= 1 AND EMPTY(lcAlias) lcFieldName = "" CASE iPos = 0 iPos = LEN(lcAlias)+ 1 lcFieldName = lcAlias+"."+lcFieldName CASE iPos = 1 iPos = LEN(lcAlias)+ 1 lcFieldName = lcAlias+lcFieldName CASE iPos = 2 AND LEFT(lcFieldName,1) = "M" * we can't use a memvar lcFieldName = "" OTHERWISE * we may have an aliased field * or we may have a property -- * which is it?? IF NOT USED(SUBSTR(lcAlias,1,iPos-1)) lcFieldName = "" ENDIF ENDCASE * okay, now do we have something usable? IF NOT EMPTY(lcFieldName) IF TYPE(lcFieldName) = "U" lcFieldName = "" ENDIF ENDIF RETURN lcFieldName ENDPROC PROCEDURE settoactivesession LOCAL liSession liSession = SET("DATASESSION") * we may be calling from the menu or a toolbar: DO CASE CASE TYPE("_SCREEN.ActiveForm.DatasessionID") = "N" AND ; liSession # _SCREEN.ActiveForm.DatasessionID SET DATASESSION TO (_SCREEN.ActiveForm.DatasessionID) CASE TYPE("_SCREEN.ActiveForm.Parent.DatasessionID") = "N" AND ; liSession # _SCREEN.ActiveForm.Parent.DatasessionID SET DATASESSION TO (_SCREEN.ActiveForm.Parent.DatasessionID) OTHERWISE * we're in the right datasession already ENDCASE ENDPROC PROCEDURE refreshuiafterchange DO CASE CASE TYPE("_SCREEN.ActiveForm.Parent") = "O" _SCREEN.ActiveForm.Parent.Refresh() CASE TYPE("_SCREEN.ActiveForm") = "O" _SCREEN.ActiveForm.Refresh() OTHERWISE IF NOT EMPTY(WONTOP()) SHOW WINDOW (WONTOP()) REFRESH ENDIF ENDCASE ENDPROC PROCEDURE currentrowbufferedandchanged LPARAMETERS tcAlias ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) LOCAL lcAlias, llReturn, loCurrentControl, lcCurrentField IF EMPTY(tcAlias) lcAlias = THIS.GetCurrentAlias() ELSE lcAlias = tcAlias ENDIF IF (NOT EMPTY(lcAlias)) AND ; (EMPTY(RECCOUNT(lcAlias))) lcAlias = "" ENDIF IF (NOT EMPTY(lcAlias)) AND ; INLIST(CURSORGETPROP("BUFFERING",lcAlias), ; DB_BUFLOCKRECORD, ; DB_BUFOPTRECORD) lcCurrentField = THIS.GetCurrentBoundField() * return of GetCurrentBoundField() will always be aliased IF NOT EMPTY(lcCurrentField) IF UPPER(LEFT(lcCurrentField,LEN(lcAlias)+1)) == ; UPPER(lcAlias)+"." * check to see if we would need to flush the current control * to actually see a change: loCurrentControl = THIS.GetCurrentControl() IF (NOT ISNULL(loCurrentControl)) AND ; PEMSTATUS(loCurrentControl,"Value",5) AND ; (NOT EVAL(lcCurrentField) == loCurrentControl.Value) * we definitely have a change llReturn = .T. ENDIF ENDIF ENDIF IF NOT llReturn && yet llReturn = (GETFLDSTATE(-1,lcAlias) # ; REPL("1",FCOUNT(lcAlias)+1)) ENDIF ENDIF RETURN llReturn ENDPROC PROCEDURE currenttableallowsnavigation LPARAMETERS tcAlias ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) LOCAL lcAlias, liReturn IF (NOT EMPTY(tcAlias)) AND USED(tcAlias) lcAlias = tcAlias ELSE lcAlias = THIS.GetCurrentAlias() ENDIF IF (NOT EMPTY(lcAlias)) AND ; (EMPTY(RECCOUNT(lcAlias))) lcAlias = "" ENDIF IF (NOT EMPTY(lcAlias)) AND ; THIS.CurrentRowBufferedAndChanged(lcAlias) IF INLIST(_VFP.Startmode,0,4) liReturn = MESSAGEBOX(TABLE_MESSAGE_ROW_CHANGED_LOC,; MB_ICONEXCLAMATION+MB_YESNOCANCEL, ; TABLE_MESSAGE_TITLE_ROW_CHANGED_LOC) ELSE lcAlias = "" ENDIF DO CASE CASE EMPTY(lcAlias) * we're in a server * and we shouldn't be moving * the record pointer here; * should make the determination * to revert or update somewhere else! CASE liReturn = IDYES THIS.FlushCurrentControl() IF NOT TABLEUPDATE(0,.T.,lcAlias) lcAlias = "" ENDIF CASE liReturn = IDNO =TABLEREVERT(.F.,lcAlias) OTHERWISE && cancel lcAlias = "" ENDCASE ENDIF RETURN (NOT EMPTY(lcAlias)) ENDPROC PROCEDURE refreshlastwindowafterchange LOCAL loForm, liForms, liThisForm, loThisForm liForms = _SCREEN.FormCount IF TYPE("THISFORM") = "O" loThisForm = THISFORM ELSE loThisForm = .NULL. ENDIF DO CASE CASE liForms > 1 * find the next one down in the stack, not counting toobars FOR liThisForm = 2 TO liForms loForm = _SCREEN.Forms(liThisForm) IF (NOT ISNULL(loThisForm)) AND loForm = loThisForm LOOP ENDIF IF UPPER(loForm.BaseClass) == "FORM" IF TYPE("loForm.Parent") = "O" loForm.Parent.Refresh() ELSE loForm.Refresh() ENDIF EXIT ENDIF ENDFOR CASE _SCREEN.Visible _SCREEN.Refresh() OTHERWISE * Not much we can do... ENDCASE ENDPROC PROCEDURE currenttableallowsordering LPARAMETERS tcAlias ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) LOCAL lcAlias, llReturn, loCurrentControl, ; loCurrentGrid, liIndex, liTables, liTarget, lcTarget LOCAL ARRAY laTables[1,2] IF (NOT EMPTY(tcAlias)) AND USED(tcAlias) lcAlias = tcAlias ELSE lcAlias = THIS.GetCurrentAlias() ENDIF IF (NOT EMPTY(lcAlias)) lcAlias = UPPER(lcAlias) llReturn = .T. * check for grid in a child relation loCurrentControl = THIS.GetCurrentControl() DO WHILE TYPE("loCurrentControl.Parent.Baseclass") = "C" loCurrentControl = loCurrentControl.Parent IF UPPER(loCurrentControl.Baseclass) == "GRID" loCurrentGrid = loCurrentControl EXIT ENDIF ENDDO IF TYPE("loCurrentGrid.Name") = "C" AND ; (NOT EMPTY(loCurrentGrid.LinkMaster+; loCurrentGrid.ChildOrder+; loCurrentGrid.RelationalExpr)) llReturn = .F. ENDIF ENDIF IF llReturn * check for a relational expression even though * this isn't a grid liTables = AUSED(laTables) FOR liIndex = 1 TO liTables liTarget = 1 lcTarget = UPPER(TARGET(1,laTables[liIndex,1])) DO WHILE NOT EMPTY(lcTarget) IF lcAlias == lcTarget llReturn = .F. EXIT ELSE liTarget = liTarget + 1 lcTarget = UPPER(TARGET(liTarget,laTables[liIndex,1])) ENDIF ENDDO IF NOT llReturn EXIT ENDIF ENDFOR ENDIF IF NOT llReturn THIS.DoTargetOfRelationMessage(lcAlias) ENDIF RETURN llReturn ENDPROC PROCEDURE dotargetofrelationmessage LPARAMETERS tcAlias IF EMPTY(tcAlias) RETURN ENDIF ENDPROC PROCEDURE flushcurrentcontrol LPARAMETERS tcAlias ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) LOCAL lcAlias, llReturn, loCurrentControl, lcCurrentField IF EMPTY(tcAlias) lcAlias = THIS.GetCurrentAlias() ELSE lcAlias = tcAlias ENDIF IF (NOT EMPTY(lcAlias)) AND ; (EMPTY(RECCOUNT(lcAlias))) lcAlias = "" ENDIF IF (NOT EMPTY(lcAlias)) AND ; INLIST(CURSORGETPROP("BUFFERING",lcAlias), ; DB_BUFLOCKRECORD, ; DB_BUFOPTRECORD) lcCurrentField = THIS.GetCurrentBoundField() * return of GetCurrentBoundField() will always be aliased IF NOT EMPTY(lcCurrentField) IF UPPER(LEFT(lcCurrentField,LEN(lcAlias)+1)) == ; UPPER(lcAlias)+"." loCurrentControl = THIS.GetCurrentControl() IF (NOT ISNULL(loCurrentControl)) AND ; PEMSTATUS(loCurrentControl,"Value",5) loCurrentControl.Value = loCurrentControl.Value llReturn = .T. ENDIF ENDIF ENDIF ENDIF RETURN llReturn ENDPROC ? &&N %=Ut T %CCC dTC.b Hk CNYIIT[]+ ALLTRIM(STR( ,12,4))+[] CCM1T[]++[] Dh?T[]+DTOC()+[] T?T[]+TTOC()+[] LKT[]+ IIF( ,'.T.','.F.')+[]TCCCXf%C `%C\(TC[] Ta%C+TC%C+ &TCC-%C[] JTT- BU TCFIELD LLSKIPPED LCTHISFIELDLCTHISFIELDTYPETHISCALIASCCONTROLCHARACTERCFIELDS LFINDAGAIN C CC C CC  Ta%C qT%C T-%C T%CTC%C T%C( T- %PTC %  T CW F TCO%  %C+ H-% -$CC -$CC %C+ % ^-CC -CC  %C+ C # T- F T  BU TCFINDSTRINGTCALIAS LLSUCCESSTHIS CFINDSTRINGCALIASGETCURRENTALIASCURRENTTABLEALLOWSNAVIGATIONLIRECNOLISELECT LFINDAGAIN LMATCHCASECFIELDS LWRAPAROUNDSHOWMESSAGENOTFOUND H CCC aTTT- Cw2TC CT-UTCNEWVALTHISCALIASCFIELDS LFINDAGAIN SETFIELDSl%CC#B-%CV=eJCV(T-UTCNEWVALTHIS CFINDSTRING LFINDAGAINE%CC>C R,:C Not found=U STARTMODE%CCC 6T~%CXTC CUTCNEWVALTHISCCONTROLCHARACTER SETFIELDSh%%CC C 9TBTT[]T-(C. TC/TC.b H  M TT.T++[] C.T++[] CNIY!BT+ ALLTRIM(STR( ,12,4))+[] Dh5T+ DTOC()+[] T5T+ TTOC()+[] L@T+ IIF(,'.T.','.F.')+[]2 TCCCXf!%[]aTU THISCALIASCFIELDSLIINDEX LCTHISFIELDLCTHISFIELDTYPEIMEMOSCCONTROLCHARACTERAMEMOS LSKIPMEMOS T UVNEWVALTHIS LWRAPAROUNDH%ATT-UTLNEWVALTHIS LMATCHCASE LFINDAGAINU%NT-T CUTLNEWVALTHIS LSKIPMEMOS LFINDAGAIN SETFIELDSTUTLNEWVALTHIS LFINDAGAIN skipfield,dofind  calias_assigncfindstring_assignshowmessagenotfound? ccontrolcharacter_assign setfieldsS lwraparound_assign,lmatchcase_assignjlskipmemos_assignlfindagain_assignj1qq!!!AAaAAAAA3rA"AA!AA1A!AqAAAAAAaAAAB4qa!A4qQqAa!A3qA2qbAA3QAAAQq1!"!R!R!BAA3!3qAA2qAA2q1& 4b o,y2~"Ir_*R)&%M 4%4%'F%#v U H  nMJ-(   %T %J-( %Ja(29Ja(,T  /T   U THISIQPTRCMDRESETENABLEDCMDORCMDOK LSTQUERYPARTS CMDDELETECMDUPCMDDOWNVALUE{T TTT=TC CU THISAQUERYIQPTR LSTQUERYPARTSVALUE CBOOPERATOR EDTSOUGHTREFRESH SETACTION%CTC%C bBTC TC.%IT =T :%CbU CC\fCCf. T E,T C CC\ ZTC\:%CbU CC\fCCf. T ,T C CC\ TC\TC T C\#T CC\      ULCXLII LCFIELDNAMELIDOTTHIS LSTQUERYPARTSVALUEIQPTRAQUERY CBOOPERATOR EDTSOUGHT CBOFIELDNAMEAFLDSONTAGNOBRACKREFRESH "%C*OR*R%J-( Ta%TT =T!TCC  TCb#JL( U LCXLCTYPTHISAQUERY LSTQUERYPARTSVALUE CBOFIELDNAMEENABLED EDTSOUGHT CBOOPERATORNOTAGAFLDS T(C>{TC\%'{} wT BUTCXLIILCYLCC.%C\CC>\ Y B% INB T T+C>TC,% T TBTC\*TCC> C\6%C>kT,T BU TCXTCB1TCB2LCOUTLIILCVLCXTHIS CBOOPERATORVALUETRecord#CV(CqTCC.(C%CC/bGT\C/TCC/UTHISATAGSIFLAFLDSONTAGH.TCC* 6 BUTCXLCXTHISATAGS,TC\ BUTCXLCX TTC %\ BTC\TC\TC T C\TC\% IN BT(+C>TC,%] T TTC\*TCC> C\6%CR(T OR T=T) BU TCXLCVARLIILCORIGLCOUTLCVLCXTHIS CBOOPERATORVALUE!TTHISFORM.aFlds!TTHISFORM.aTags!TTHISFORM.aDbfs"TTHISFORM.aQueryUTHIS CBOFIELDNAME ROWSOURCECBOORDER CBOTABLES LSTQUERYPARTS' T% R( %C *OR*#T(CCC ` !( %C *OR*( %C *OR* .T) OR ( %C *OR*fT AND "TCCC ` T)TC OR ()%TC\%C>+#R,:CExpression too long= B TCWTCC] TCUSELECT COUNT(*) AS myTally, .T. FROM (ALIAS()) WHERE &lcx INTO CURSOR (lcAlias) TC3TCC 9,999,999_ Records, 7TCC999.99_ Seconds. Q FR,:C=%CuJ( JCr( ULCXLIILNSTIMELNETIMELCYLIKLIEMPTYLISELECTLCALIASTHISFORMIQPTRAQUERY EDITQUERYMYTALLYCFILTERC CC TT T%CTT-B     T Cr T TC >J(   +a\T  T C \T  %C "'[]F%C "' CR   ]CR[  TCC>=% ]T  H. C> C R.OR.T C C >=TT TT*OR* T  C R.AND.&T C C >=TT T 2."%  X!TT TTaU TCQUERYSTRINGTHISAQUERY IQUERYMAXCFILTERIQPTR LSTQUERYPARTSVALUEENABLED LCQUERYSTRING LCTHISPART LITHISCHARLCSTRINGLENGTH LCTHISCHAR LCDELIMITERSLISTRINGLENGTH  TC +a H@ C(C)a! C=(,(C%CCR)1TCCCC>='TCC6!TC\ CR)(%CC=(#TCC\'TCC6!TCC>=2!BUPIITEMILCITEMTHISFORMAQUERY%C B-:%C toCaller.NamebCC SetFilterh jTT TTT= C %C MS Sans Serif$ !C MS Sans Serif$ !C MS Sans Serif$ !C MS Sans Serif$   CFontNameArial BU TOCALLERTHISOCALLERAQUERY IQUERYMAXIQPTR EDTSOUGHTVALUE CBOOPERATOR SETROWSOURCESSETALL TCyTCWTCEXACTvG&%C CC &R,:CChecking open files.. =%FQ?%CCR,:C Cancelled=B-B TTCCCT ( TCCCR %CCFCT  T CCC T CFILTERv H:% CTHIS.oCaller.NamebCuC  C    C C 2C   CULIDBCLIINDEXLATEMPTHISISELECT COLDEXACTADBFS CBOTABLESREQUERYVALUELCFILTERSETINITIALQUERYPARTSOCALLERCFILTER SETUPFILTER SETACTION=TSET EXACT &lcExact FULCEXACTTHIS COLDEXACTISELECT setaction,qreset)qsetfsetnobrackbracketsLsettags) ontagR notag editquery setrowsourcesO setupfiltersetinitialqueryparts1 cleanparensInitActivate Deactivated1BSTTB31A1311AA11A11A1Aa11AA3!Sq1A1A3A2qQQAA21AAA1A1!AA4qAAaAA5qq3qq!3q1Aa1aAA1AqQAA!3!2qB1AAAAAqaA!AA!A11AQS1qaA1A3q21AAQQe!AAB1qqqB#AACs3qRBqqAAA!q1qAAABAAA2qqAB21Ab AB31!qacbAqq1AqAARB1ArQQaA4qa2K*f 47- o ZF 8 nQW yzkz zzw##s(q/(Q+Ap+0q0H1)4%1SPROCEDURE setaction DO CASE CASE THIS.iQptr = 0 STORE .F. TO THIS.cmdReset.Enabled, ; THIS.cmdOr.Enabled, ; THIS.cmdOK.Enabled, ; THIS.lstQueryParts.Enabled, ; THIS.cmdDelete.Enabled, ; THIS.cmdUp.Enabled, ; THIS.cmdDown.Enabled CASE THIS.lstQueryParts.Value > THIS.iQptr THIS.cmdOr.Enabled = ; (THIS.lstQueryParts.Value = THIS.iQptr + 1) STORE .F. TO THIS.cmdDelete.Enabled, ; THIS.cmdUp.Enabled, ; THIS.cmdDown.Enabled STORE .T. TO THIS.cmdReset.Enabled, ; THIS.cmdOK.Enabled, ; THIS.lstQueryParts.Enabled OTHERWISE STORE .T. TO THIS.cmdReset.Enabled, ; THIS.cmdOK.Enabled, ; THIS.cmdOr.Enabled, ; THIS.lstQueryParts.Enabled, ; THIS.cmdDelete.Enabled THIS.cmdUp.Enabled = ; (THIS.iQptr # 1 AND THIS.lstQueryParts.Value # 1) THIS.cmdDown.Enabled = ; (THIS.iQptr # 1 AND THIS.iQptr # THIS.lstQueryParts.Value) ENDCASE ENDPROC PROCEDURE qreset THIS.aQuery = " " THIS.iQptr = 0 THIS.lstQueryParts.Value = 1 THIS.cboOperator.Value = "=" THIS.edtSought.Value = "" THIS.edtSought.Refresh() THIS.SetAction() ENDPROC PROCEDURE qset LOCAL lcx, lii, lcFieldname, liDot IF BETWEEN(1,THIS.lstQueryParts.Value,THIS.iQptr) lcx = THIS.aQuery(THIS.lstQueryParts.Value) IF lcx = CHR(205) && "" -- should it be "=" ?? RETURN ENDIF lii = AT(" ",lcx) liDot = AT(".",lcx) IF lii <= 1 THIS.cboOperator.Value = "=" THIS.edtSought.Value = "" IF TYPE(lcx) = "U" OR liDot = 0 OR ; UPPER(SUBSTR(lcx,1,liDot)) # UPPER(ALIAS())+"." THIS.cboFieldname.Value = 1 ELSE THIS.cboFieldname.Value = ASCAN(THIS.aFlds,THIS.OnTag(SUBSTR(lcx,liDot+1))) ENDIF ELSE lcFieldName = SUBSTR(lcx,1,lii-1) IF TYPE(lcFieldName) = "U" OR liDot = 0 OR ; UPPER(SUBSTR(lcFieldName,1,liDot)) # UPPER(ALIAS())+"." THIS.cboFieldName.Value = 1 ELSE THIS.cboFieldName.Value = ASCAN(THIS.aFlds,THIS.OnTag(SUBSTR(lcFieldName,liDot+1))) ENDIF lcx = SUBSTR(lcx,lii+1) lii = AT(" ",lcx) THIS.cboOperator.Value = SUBSTR(lcx,1,lii-1) THIS.edtSought.Value = THIS.Nobrack(SUBSTR(lcx,lii+1)) ENDIF THIS.cboFieldName.Refresh THIS.cboOperator.Refresh THIS.edtSought.Refresh ENDIF ENDPROC PROCEDURE fset LOCAL lcx, lctyp IF THIS.aQuery(THIS.lstQueryParts.Value) = "*OR*" STORE .F. TO THIS.cboFieldName.Enabled, ; THIS.edtSought.Enabled, ; THIS.cboOperator.Enabled ELSE THIS.cbofieldname.Enabled = .T. IF THIS.cboFieldname.Value = 0 THIS.cboFieldname.Value = 1 THIS.cboOperator.Value = "=" THIS.edtSought.Value = "" ENDIF lcx = THIS.NoTag(THIS.aFlds[THIS.cbofieldname.Value]) lctyp = TYPE(lcx) STORE (lcTyp # "L") TO ; THIS.cboOperator.Enabled, ; THIS.edtSought.Enabled ENDIF ENDPROC PROCEDURE nobrack LPARAMETERS tcx LOCAL lii,lcy,lcC lcy = "" FOR lii = 1 TO LEN(tcx) lcC = SUBSTR(tcx,lii,1) IF NOT lcC$"'{}" lcy = lcy + lcC ENDIF ENDFOR RETURN lcy ENDPROC PROCEDURE brackets LPARAMETERS tcx, tcb1, tcb2 LOCAL lcout, lii, lcv, lcx IF SUBSTR(tcx,1,1)=tcb1 AND SUBSTR(tcx,LEN(tcx),1)=tcb2 RETURN tcx ENDIF IF THIS.cboOperator.Value = "IN" RETURN tcb1 + tcx + tcb2 ENDIF lcout = "" lcx = tcx DO WHILE LEN(lcx) > 0 lii = AT(",", lcx) IF lii = 0 lcv = lcx lcx = "" ELSE lcv = SUBSTR(lcx,1,lii-1) lcx = IIF(lii=LEN(lcx),"",SUBSTR(lcx,lii+1)) ENDIF IF LEN(lcout) > 0 lcout = lcout + "," ENDIF lcout = lcout + tcb1 + lcv + tcb2 ENDDO RETURN lcout ENDPROC PROCEDURE settags THIS.aTags[1] = "Record#" LOCAL iFl DIME THIS.aTags[TAGCOUNT()+1] FOR iFl = 2 TO (ALEN(THIS.aTags)) THIS.aTags(iFl) = TAG(iFl-1) ENDFOR DIME THIS.aFlds[FCOUNT()] FOR ifl = 1 TO ALEN(THIS.aFlds) IF TYPE(FIELD(ifl)) = "G" THIS.aFlds[ifl] = "\"+FIELD(ifl) ELSE THIS.aFlds[ifl] = ; THIS.OnTag(FIELD(ifl)) ENDIF ENDFOR ENDPROC PROCEDURE ontag LPARAMETERS tcx LOCAL lcX lcx = IIF(ASCAN(THIS.aTags,tcx)#0,"*"," ") + tcx RETURN lcx ENDPROC PROCEDURE notag LPARAMETERS tcX LOCAL lcX lcX = SUBSTR(tcx,2) RETURN lcX ENDPROC PROCEDURE editquery LPARAMETERS tcx LOCAL lcvar, lii, lcorig, lcout, lcv, lcx lcorig = tcx lii = AT(" ", tcx) IF lii = 0 RETURN lcorig ENDIF lcvar = SUBSTR(tcx,1,lii-1) lcx = SUBSTR(tcx,lii+1) lii = AT(" ", lcx) THIS.cboOperator.Value = SUBSTR(lcx,1,lii-1) lcx = SUBSTR(lcx,lii+1) IF THIS.cboOperator.Value # "IN" RETURN lcorig ENDIF lcout = "(" DO WHILE LEN(lcx) > 0 lii = AT(",", lcx) IF lii = 0 lcv = lcx lcx = "" ELSE lcv = SUBSTR(lcx,1,lii-1) lcx = IIF(lii=LEN(lcx),"",SUBSTR(lcx,lii+1)) ENDIF IF RIGHT(lcout,1) # "(" lcout = lcout + " OR " ENDIF lcout = lcout + lcvar + "=" + lcv ENDDO lcout = lcout + ")" RETURN lcout ENDPROC PROCEDURE setrowsources THIS.cboFieldName.RowSource = "THISFORM.aFlds" THIS.cboOrder.RowSource = "THISFORM.aTags" THIS.cboTables.RowSource = "THISFORM.aDbfs" THIS.lstQueryParts.RowSource = "THISFORM.aQuery" ENDPROC PROCEDURE setupfilter LOCAL lcx, lii, lnstime, lnetime, lcy, lik, liempty, liSelect, lcAlias lcx = "" IF THISFORM.iQptr # 0 FOR lik = 1 TO THISFORM.iQptr IF THISFORM.aQuery(lik)#"*OR*" lcx = "("+THISFORM.EditQuery(TRIM(THISFORM.aQuery(lik))) EXIT ENDIF ENDFOR FOR lii = lik+1 TO THISFORM.iQptr IF THISFORM.aQuery(lii) = "*OR*" IF THISFORM.aQuery(lii-1) = "*OR*" LOOP ENDIF lcx = lcx + ") OR (" ELSE IF THISFORM.aQuery(lii-1) # "*OR*" lcx = lcx + " AND " ENDIF lcx = lcx + THISFORM.EditQuery(TRIM(THISFORM.aQuery(lii))) ENDIF ENDFOR lcx = lcx + ")" liempty = RAT(' OR ()',lcx) IF liempty#0 lcx = SUBSTR(lcx,1,liempty-1) ENDIF IF LEN(lcx) > FILTER_MAX_FILTER WAIT WINDOW LEFT(FILTER_TOO_LONG_LOC,254) NOWAIT RETURN 0 ENDIF liSelect = SELECT() lcAlias = "C"+SYS(2015) lnstime = SECONDS() SELECT COUNT(*) AS myTally, .T. ; FROM (ALIAS()) WHERE &lcx ; INTO CURSOR (lcAlias) lnetime = SECONDS() lcy = ALLTRIM(TRANS(myTally,"9,999,999"))+" "+ FILTER_RECORDS_LOC+", " lcy = lcy + ALLTRIM(TRANS(lnetime-lnstime,"999.99")) + " "+FILTER_SECONDS_LOC+"." USE IN (lcAlias) SELECT (liSelect) WAIT WINDOW LEFT(lcy,254) NOWAIT TIMEOUT 2 ENDIF IF EMPTY(lcx) STORE "" TO THISFORM.cfilter ELSE STORE NORMALIZE(lcx) TO THISFORM.cFilter ENDIF ENDPROC PROCEDURE setinitialqueryparts LPARAMETERS tcQueryString ASSERT EMPTY(tcQueryString) OR VARTYPE(tcQueryString) = "C" DIME THIS.aQuery[THIS.iQueryMax] THIS.cFilter = "" THIS.aQuery = " " THIS.iqptr = 0 IF EMPTY(tcQueryString) THIS.lstQueryParts.Value = 1 THIS.lstQueryParts.Enabled = .F. RETURN ENDIF LOCAL lcQueryString, lcThisPart, liThisChar, ; lcStringLength, lcThisChar, lcDelimiters lcQueryString = NORMALIZE(tcQueryString) liThisChar = 0 liStringLength = LEN(lcQueryString) STORE "" TO lcThisPart, lcThisChar, lcDelimiters DO WHILE .T. liThisChar = liThisChar + 1 lcThisChar = SUBSTR(lcQueryString,liThisChar,1) lcThisPart = lcThisPart + lcThisChar IF INLIST(lcThisChar,["], ['],"[", "]" ) IF (INLIST(lcThisChar,["],[']) AND ; RIGHT(lcDelimiters,1) = lcThisChar) OR ; (lcThisChar = "]" AND ; RIGHT(lcDelimiters,1) = "[") * finishing an expression lcDelimiters = LEFT(lcDelimiters, LEN(lcDelimiters)-1) ELSE IF lcThisChar # "]" lcDelimiters = lcDelimiters + lcThisChar ENDIF ENDIF ENDIF DO CASE CASE LEN(lcDelimiters) > 0 * we're in an expression CASE RIGHT(lcThisPart,4) = ".OR." lcThisPart = LEFT(lcThisPart,LEN(lcThisPart)-4) THIS.iQptr = THIS.iQptr + 1 THIS.aQuery(THIS.iQptr) = lcThisPart THIS.iQptr = THIS.iQptr + 1 THIS.aQuery(THIS.iQptr) = "*OR*" lcThisPart = "" CASE RIGHT(lcThisPart,5) = ".AND." lcThisPart = LEFT(lcThisPart,LEN(lcThisPart)-5) THIS.iQptr = THIS.iQptr + 1 THIS.aQuery(THIS.iQptr) = lcThisPart lcThisPart = "" OTHERWISE * continue ENDCASE IF liThisChar = liStringLength OR ; THIS.iQptr = THIS.iQueryMax EXIT ENDIF ENDDO * final "part" THIS.iQptr = THIS.iQptr + 1 THIS.aQuery(THIS.iQptr) = lcThisPart THIS.lstQueryParts.Value = THIS.iQptr+1 THIS.lstQueryParts.Enabled = .T. ENDPROC PROCEDURE cleanparens LPARAMETERS piItem *- *- remove parens from filter *- Called from cmdDelete:Click and THISFORM:Init *- LOCAL i, lcItem lcItem = THISFORM.aQuery[piItem] DO WHILE .T. *- there may be multiple sets of parentheses, so loop through *- till we get rid of all of them DO CASE CASE OCCURS("(", lcItem) == OCCURS(")",lcItem) *- ignore, since same number of left and right parens are on this item EXIT CASE LEFT(lcItem,1) == "(" *- scan forward, looking for matching ")" FOR i = piItem TO ALEN(THISFORM.aquery,1) IF RIGHT(THISFORM.aQuery[i],1) == ")" THISFORM.aQuery[i] = LEFT(THISFORM.aquery[i],LEN(THISFORM.aquery[i]) - 1) lcItem = IIF(i == piItem, THISFORM.aQuery[i], lcItem) EXIT ENDIF NEXT lcItem = SUBSTR(lcItem,2) && strip left paren CASE RIGHT(lcItem,1) == ")" *- scan backward, looking for matching "(" FOR i = piItem TO 1 STEP -1 IF LEFT(THISFORM.aQuery[i],1) == "(" THISFORM.aQuery[i] = SUBSTR(THISFORM.aquery[i],2) lcItem = IIF(i == piItem, THISFORM.aQuery[i], lcItem) EXIT ENDIF NEXT lcItem = LEFT(lcItem, LEN(lcItem) - 1) && strip right paren OTHERWISE *- nothing to do EXIT ENDCASE ENDDO RETURN ENDPROC PROCEDURE Init LPARAMETERS toCaller IF NOT DODEFAULT() RETURN .F. ENDIF IF TYPE("toCaller.Name") = "C" AND ; PEMSTATUS(toCaller,"SetFilter",5) && this dialog is really only supposed && to be called by a parent dialog, but && what the heck, if you don't call it this way && we will set the filter directly... THIS.oCaller = toCaller ENDIF DIME THIS.aQuery[THIS.iQueryMax] THIS.aQuery = " " THIS.iqptr = 0 THIS.edtSought.Value = "" THIS.cboOperator.Value = "=" THIS.SetRowSources() IF SYSTEM_LARGEFONTS THIS.SetAll("FontName",DIALOG_LARGEFONT_NAME) ENDIF RETURN ENDPROC PROCEDURE Activate LOCAL lidbc, liIndex LOCAL ARRAY laTemp[1,2] lidbc=AUSED(laTemp) THIS.iSelect = SELECT() THIS.cOldExact = SET("EXACT") SET EXACT OFF IF lidbc # ALEN(THIS.aDbfs) OR ; EMPTY(THIS.aDbfs[1]) && empty array will happen only the first time WAIT WINDOW NOWAIT LEFT(FILTER_CHECKING_OPEN_TABLES_LOC,254) IF lidbc = 0 USE ? IF EMPTY(ALIAS()) WAIT WINDOW LEFT(FILTER_CANCELLED_LOC,254) NOWAIT NODEFAULT RETURN .F. ELSE lidbc = 1 THIS.aDbfs[1] = PROPER(ALIAS()) THIS.cboTables.Requery() THIS.cboTables.Value = 1 ENDIF ELSE DIME THIS.aDbfs[lidbc] FOR liIndex = 1 TO lidbc THIS.aDbfs[liIndex] = PROPER(laTemp[liIndex,1]) ENDFOR THIS.cboTables.Requery() ENDIF WAIT CLEAR ENDIF IF EMPTY(ALIAS()) SELECT (THIS.aDbfs[1]) THIS.cboTables.Value = 1 ELSE THIS.cboTables.Value = ASCAN(THIS.aDbfs,PROPER(ALIAS())) ENDIF LOCAL lcFilter lcFilter = SET("FILTER") DO CASE CASE TYPE("THIS.oCaller.Name") = "C" THIS.SetInitialQueryParts(THIS.oCaller.cFilter) CASE THIS.SetupFilter() AND ; (THIS.cFilter == lcFilter) * don't touch CASE EMPTY(lcFilter) THIS.SetInitialQueryParts("") OTHERWISE THIS.SetInitialQueryParts(lcFilter) ENDCASE THIS.SetAction() ENDPROC PROCEDURE Deactivate LOCAL lcExact lcExact = THIS.cOldExact SET EXACT &lcExact SELECT (THIS.iSelect) ENDPROC PROCEDURE skipfield LPARAMETERS tcField LOCAL llSkipped, lcThisField, lcThisFieldType lcThisField = "" IF VARTYPE(tcField) = "C" AND NOT(EMPTY(tcField)) lcThisFieldType = TYPE(THIS.cAlias+"."+tcField) DO CASE CASE INLIST(lcThisFieldType,"N","Y","I") lcThisField = "["+THIS.cControlCharacter+"]" + ; "+ ALLTRIM(STR("+ ; tcField + ; ",12,4))+["+THIS.cControlCharacter+"]" CASE INLIST(lcThisFieldType,"C","M") lcThisField = "["+THIS.cControlCharacter+"]+" + ; tcField + ; "+["+THIS.cControlCharacter+"]" CASE lcThisFieldType = "D" lcThisField = "["+THIS.cControlCharacter+"]" + ; "+DTOC("+tcField+")" + ; "+["+THIS.cControlCharacter+"]" CASE lcThisFieldType = "T" lcThisField = "["+THIS.cControlCharacter+"]" + ; "+TTOC("+tcField+")" + ; "+["+THIS.cControlCharacter+"]" CASE lcThisFieldType = "L" lcThisField = "["+THIS.cControlCharacter+"]" + ; "+ IIF("+tcField+",'.T.','.F.')"+ ; "+["+THIS.cControlCharacter+"]" ENDCASE lcThisField = UPPER(STRTRAN(lcThisField,SPACE(1),"")) IF NOT EMPTY(lcThisField) IF ATCC(lcThisField, THIS.cFields) > 0 THIS.cFields = STRTRAN(THIS.cFields,lcThisField,"["+THIS.cControlCharacter+"]") llSkipped = .T. IF LEFTC(THIS.cFields,1) = "+" THIS.cFields = SUBSTRC(THIS.cFields,2) ENDIF IF RIGHTC(THIS.cFields,1) = "+" THIS.cFields = SUBSTRC(THIS.cFields,1,LENC(THIS.cFields)-1) ENDIF IF EMPTY(THIS.cFields) OR ; THIS.cFields == "["+THIS.cControlCharacter+"]" THIS.cAlias = "" ENDIF THIS.lFindAgain = .F. ENDIF ENDIF ENDIF RETURN llSkipped ENDPROC PROCEDURE dofind LPARAMETERS tcFindString, tcAlias ASSERT EMPTY(tcFindString) OR VARTYPE(tcFindString) = "C" ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" LOCAL llSuccess llSuccess = .T. IF NOT EMPTY(tcFindString) THIS.cFindString = tcFindString ENDIF IF EMPTY(THIS.cFindString) llSuccess = .F. ENDIF IF NOT EMPTY(tcAlias) THIS.cAlias = tcAlias ENDIF IF EMPTY(THIS.cAlias) THIS.cAlias = THIS.GetCurrentAlias() ENDIF IF NOT USED(THIS.cAlias) THIS.cAlias = "" ENDIF IF EMPTY(THIS.cAlias) llSuccess = .F. ENDIF IF llSuccess llSuccess = THIS.CurrentTableAllowsNavigation(THIS.cAlias) ENDIF IF llSuccess * now do the real work LOCAL liRecno, liSelect liSelect = SELECT() SELECT (THIS.cAlias) liRecno = RECNO() IF THIS.lFindAgain IF NOT EOF() SKIP ELSE LOCATE ENDIF ENDIF IF THIS.lMatchCase LOCATE REST FOR AT_C(THIS.cFindString,EVAL(THIS.cFields)) > 0 ELSE LOCATE REST FOR ATCC(THIS.cFindString,EVAL(THIS.cfields)) > 0 ENDIF IF EOF() AND THIS.lWrapAround IF THIS.lMatchCase LOCATE FOR AT_C(THIS.cFindString,EVAL(THIS.cFields)) > 0 ELSE LOCATE FOR ATCC(THIS.cFindString,EVAL(THIS.cFields)) > 0 ENDIF ENDIF IF EOF() THIS.ShowMessageNotFound() GO liRecno llSuccess = .F. ENDIF SELECT (liSelect) ENDIF THIS.lFindAgain = llSuccess RETURN llSuccess ENDPROC PROCEDURE calias_assign LPARAMETERS tcNewVal DO CASE CASE VARTYPE(tcNewVal) # "C" OR NOT USED(tcNewVal) THIS.cAlias = "" THIS.cFields = "" THIS.lFindAgain = .F. CASE THIS.cAlias == PROPER(tcNewVal) * do nothing OTHERWISE THIS.cAlias = PROPER(tcNewVal) THIS.SetFields() THIS.lFindAgain = .F. ENDCASE ENDPROC PROCEDURE cfindstring_assign LPARAMETERS tcNewVal IF VARTYPE(tcNewVal) # "C" RETURN .F. ENDIF IF RTRIM(tcNewVal) == THIS.cFindString * do nothing ELSE STORE RTRIM(tcNewVal) TO THIS.cFindString THIS.lFindAgain = .F. ENDIF ENDPROC PROCEDURE showmessagenotfound IF INLIST(_VFP.StartMode,0,4) ?? CHR(7) WAIT WINDOW NOWAIT LEFT(FIND_NOFIND_LOC,254) ENDIF ENDPROC PROCEDURE ccontrolcharacter_assign LPARAMETERS tcNewVal IF VARTYPE(tcNewVal) # "C" OR EMPTY(tcNewVal) THIS.cControlCharacter = "~" ELSE IF LEFTC(tcNewVal,1) == THIS.cControlCharacter * do nothing ELSE * one character only THIS.cControlCharacter = LEFTC(tcNewVal,1) THIS.SetFields() ENDIF ENDIF ENDPROC PROCEDURE setfields IF VARTYPE(THIS.cAlias) # "C" OR NOT USED(THIS.cAlias) THIS.cFields = "" RETURN ENDIF LOCAL liIndex, lcThisField, lcThisFieldType THIS.iMemos = 0 THIS.cFields = "["+THIS.cControlCharacter+"]" DIME THIS.aMemos[1] THIS.aMemos[1] = .F. FOR liIndex = 1 TO FCOUNT(THIS.cAlias) lcThisField = FIELD(liIndex,THIS.cAlias) lcThisFieldType = TYPE(THIS.cAlias+"."+lcThisField) DO CASE CASE lcThisFieldType = "M" AND NOT THIS.lSkipMemos THIS.iMemos = THIS.iMemos + 1 DIME THIS.aMemos(THIS.iMemos) THIS.aMemos(THIS.iMemos) = lcThisField THIS.cFields = THIS.cFields+"+"+lcThisField+"+["+THIS.cControlCharacter+"]" CASE lcThisFieldType = "C" THIS.cFields = THIS.cFields+"+"+lcThisField+"+["+THIS.cControlCharacter+"]" CASE INLIST(lcThisFieldType,"N","I","Y") THIS.cfields = ; THIS.cfields+"+ ALLTRIM(STR("+lcThisField+",12,4))+["+THIS.cControlCharacter+"]" CASE lcThisFieldType = "D" THIS.cfields = ; THIS.cfields+"+ DTOC("+lcThisField+")+["+THIS.cControlCharacter+"]" CASE lcThisFieldType = "T" THIS.cfields = ; THIS.cfields+"+ TTOC("+lcThisField+")+["+THIS.cControlCharacter+"]" CASE lcThisFieldType = "L" THIS.cfields = ; THIS.cfields+"+ IIF("+lcThisField+",'.T.','.F.')+["+THIS.cControlCharacter+"]" OTHERWISE * a type we can't yet handle ENDCASE ENDFOR THIS.cFields = UPPER(STRTRAN(THIS.cFields,SPACE(1),"")) IF THIS.cFields == "["+THIS.cControlCharacter+"]" THIS.cAlias = "" ENDIF ENDPROC PROCEDURE lwraparound_assign LPARAMETERS m.vNewVal THIS.lWrapAround = m.vNewVal ENDPROC PROCEDURE lmatchcase_assign LPARAMETERS tlNewVal IF THIS.lMatchCase = tlNewVal * do nothing ELSE THIS.lMatchCase = tlNewVal THIS.lFindAgain = .F. ENDIF ENDPROC PROCEDURE lskipmemos_assign LPARAMETERS tlNewVal IF tlNewVal = THIS.lSkipMemos * do nothing ELSE THIS.lFindAgain = .F. THIS.lSkipMemos = tlNewVal THIS.SetFields() ENDIF ENDPROC PROCEDURE lfindagain_assign LPARAMETERS tlNewVal THIS.lFindAgain = tlNewVal ENDPROC